Super Games for Windows 3/Super Games for Windows 3.iso/cardsws1/calcul.cdl

Text File | 1993-09-10 | 5.1 KB | 247 lines

//⌐ David Jean, 1993
game calculation is 21 by 18;

//   A1 A2 A3 A4
//   B1 B2 B3 B4
// D1

{--------------------------------------------------------------------------}

{****c2 est un de plus que c1}
predicate FollowWrap1?(c1, c2 : Card) is
  return ((c1 + 1) mod 13) = (c2 mod 13);

{****c2 est deux de plus que c1}
predicate FollowWrap2?(c1, c2 : Card) is
  return ((c1 + 2) mod 13) = (c2 mod 13);

{****c2 est trois de plus que c1}
predicate FollowWrap3?(c1, c2 : Card) is
  return ((c1 + 3) mod 13) = (c2 mod 13);

{****c2 est quatre de plus que c1}
predicate FollowWrap4?(c1, c2 : Card) is
  return ((c1 + 4) mod 13) = (c2 mod 13);

procedure MoveFirstFrom(c1 : card; src : stack) is
var i : integer;
begin
  i:=1;
  while 1<src! do
    if (src[i] mod 13)=c1 then
      begin
      Move src[i] to [1];
      break;
      end
    else i:=i+1;
end;

{--------------------------------------------------------------------------}

procedure About is
begin
  Clear 'About Calcul';
  write('Rules from : RΘglements officiels des jeux de cartes, Intl. playing card company limited, 1977.\n');
  write('Program : ⌐ David Jean, 1993.\n');
end;

procedure ShowSuite is
begin
  Write('Ace    2    3    4\n');
  Write('2    4    6    8\n');
  Write('3    6    9    Queen\n');
  Write('4    8    Queen    3\n');
  Write('5    10    2    7\n');
  Write('6    Queen    5    Jack\n');
  Write('7    Ace    8    2\n');
  Write('8    3    Jack    6\n');
  Write('9    5    Ace    10\n');
  Write('10    7    4    Ace\n');
  Write('Jack    9    7    5\n');
  Write('Queen    Jack    10    9\n');
  Write('King    King    King    King\n');
  Wait 'About...' About;
end;

stack A1;
stack A2;
stack A3;
stack A4;
stack B1;
stack B2;
stack B3;
stack B4;

var src : stack;

stack D1 is
  X := 2;
  Y := 9;
  Direction := over;
  w := 3;
  h := 4;
  //****************************
  Start is
    begin
    Add Ace+Spade .. king+Diamond;
    Shuffle;
    [0]:=CrossCard;
    end;
  //****************************
  SelectFrom(Spos : Index) is
    begin
    if !>0 then
      begin
      Pull 1 to Cursor;
      src:=D1;
      end;
    end;
  //****************************
  Help is
    begin
    Clear 'The Stock';
    Write('You build The Tableau or the Foundation by dragging cards from here, one by one.\n');
    Wait 'About...' About;
    end;
end D1;

{--------------------------------------------------------------------------}

stack A1 is
  X := 6;
  Y := 2;
  Direction := over;
  w := 3;
  h := 4;
  //****************************
  Start is
    MoveFirstFrom(Ace,D1);
  //****************************
  SelectTo(Spos : Index) is
    begin
    if FollowWrap1?([!],Cursor[1]) then
      Pull 1 From Cursor;
    end;
  //****************************
  Help is
    begin
    Clear 'Foundations';
    Write('Arithmetic sequences are build here.\n');
    Write('The Suite is not important.\n\n');
    Write('The goal is to bring every sequence to the king.\n\n');
    Wait 'Sequences...' ShowSuite;
    Wait 'About...' About;
    end;
end A1;

stack A2 is
  X := 10;
  Y := 2;
  Direction := over;
  w := 3;
  h := 4;
  //****************************
  Start is
    MoveFirstFrom(Deuce,D1);
  //****************************
  SelectTo(Spos : Index) is
    begin
    if FollowWrap2?([!],Cursor[1]) then
      Pull 1 From Cursor;
    end;
  //****************************
  Help from A1;
end A2;

stack A3 is
  X := 14;
  Y := 2;
  Direction := over;
  w := 3;
  h := 4;
  //****************************
  Start is
    MoveFirstFrom(Three,D1);
  //****************************
  SelectTo(Spos : Index) is
    begin
    if FollowWrap3?([!],Cursor[1]) then
      Pull 1 From Cursor;
    end;
  //****************************
  Help from A1;
end A3;

stack A4 is
  X := 18;
  Y := 2;
  Direction := over;
  w := 3;
  h := 4;
  //****************************
  Start is
    MoveFirstFrom(Four,D1);
  //****************************
  SelectTo(Spos : Index) is
    begin
    if FollowWrap4?([!],Cursor[1]) then
      Pull 1 From Cursor;
    end;
  //****************************
  Help from A1;
end A4;

{--------------------------------------------------------------------------}

stack B1 is
  X := 6;
  Y := 7;
  Direction := down;
  w := 3;
  h := 11;
  //****************************
  SelectFrom(Spos : Index) is
  begin
    if !>0 then
      begin
      Pull 1 to Cursor;
      src:=self;
      end;
  end;
  //****************************
  SelectTo(Spos : Index) is
  begin
    if src=D1 then Pull 1 from Cursor;
  end;
  //****************************
  Help is
    begin
    Clear 'The Tableau';
    Write('You can bring cards from The Stock here.\n\n');
    Write('Only the topmost card can be moved, and only to the Foundation.');
    Wait 'About...' About;
    end;
end B1;


stack B2 from B1 is
  X := 10;
  Y := 7;
end B2;

stack B3 from B1 is
  X := 14;
  Y := 7;
end B3;

stack B4 from B1 is
  X := 18;
  Y := 7;
end B4;

{--------------------------------------------------------------------------}

predicate Win? is return (A1!=13) and (A2!=13) and (A3!=13) and (A4!=13);

order D1, A1, A2, A3, A4, B1, B2, B3, B4.